home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj1186.arc / LISTPRF.PAS < prev    next >
Pascal/Delphi Source File  |  1986-09-19  |  10KB  |  271 lines
  1.     program PrintAddresses;
  2.  
  3.   { Prints address information saved by PROFILE }
  4.   { DEFINITIONS: }
  5.  
  6.     const
  7.       MaxSeg = 200;         {Maximum number of different segments}
  8.       nul    = '';          {Null character string}
  9.     type
  10.       MaxString = string[255];    {Generic big string}
  11.       string4 = string[4];        {String of length 4}
  12.     var
  13.       bins:     array[0..2048] of real;      {Allow 2048 address bins}
  14.       TableOfs: integer absolute CSeg:$5C;   {PROFILE stores seg:ofs of}
  15.       TableSeg: integer absolute CSeg:$5E;   {the data table here}
  16.       SampSeg:  integer;              {Segment of a sample in table}
  17.       SampOfs:  integer;              {Offset of a sample in table}
  18.       NSampls:  integer;              {No. of samples in table}
  19.       NSeg:     integer;              {No. of different segments}
  20.       NBIOS:    integer;              {No. of hist in BIOS}
  21.       NFD:      integer;              {No. of hits in Fixed Disk ROM}
  22.       i,j,k,n:  integer;              {Global Integer counters}
  23.       SegArray: array [1..MaxSeg,1..2] of integer;  
  24.                 { SegArray[i,1] = value of ith segment
  25.                    SegArray[i,2] = # occurrences of ith segment }
  26.       DoPrint:  boolean;                     {Logical print flag}
  27.  
  28. {$V-} {Disable type checking of character arguments.}
  29.  
  30.     procedure print (instring: MaxString);
  31.   { writes to printer if DoPrint true, otherwise to screen }
  32.     begin
  33.                         write   (     instring);
  34.       if (DoPrint) then write   (LST, instring);
  35.     end;
  36.     procedure println (instring: MaxString);
  37.   { same as print, but writes line feed too }
  38.     begin
  39.                         writeln (     instring);
  40.       if (DoPrint) then writeln (LST, instring);
  41.     end;
  42.     function Hex (HexInt: integer): string4;
  43.   { Converts an integer into a four character hexadecimal string }
  44.     const
  45.       HexCh: array[0..15] of char = '0123456789ABCDEF';
  46.     var
  47.       HexHi, HexLo: integer;
  48.     begin;
  49.       HexHi := Hi(HexInt);
  50.       HexLo := Lo(HexInt);
  51.       Hex := HexCh [HexHi div 16] +
  52.              HexCh [HexHi - 16*(HexHi div 16)] +
  53.              HexCh [HexLo div 16] +
  54.              HexCh [HexLo - 16*(HexLo div 16)];
  55.     end;
  56.     procedure AddSeg (Segval: integer);
  57.     var
  58.       oldseg: boolean;
  59.   { increments the tally of hits on a segment in segment array
  60.     or adds a segment to the segment array}
  61.     begin
  62.       oldseg := false;
  63.       for i := 1 to NSeg do
  64.       begin
  65.         if (Segval = SegArray[i,1]) then
  66.         begin
  67.           oldseg := true;
  68.           SegArray[i,2] := SegArray[i,2] + 1;
  69.         end;
  70.       end;
  71.       if (oldseg = false) then
  72.         if (NSeg < MaxSeg) then
  73.         begin
  74.           NSeg :=  NSeg + 1;
  75.           SegArray [NSeg,1] := Segval;
  76.           SegArray [NSeg,2] := 1;
  77.         end;
  78.     end;
  79.     procedure Loop;
  80.   { Loop over hits, doing accumulations and conversions }
  81.     begin
  82.       NSeg  := 0;
  83.       NFD   := 0;
  84.       NBIOS := 0;
  85.       NSampls := MemW [TableSeg:(TableOfs-2)];  
  86.   { PROFILE stuffs number of samples before beginning of table here }
  87.       n := 0;
  88.       for i := 1 to NSampls do    { Loop over the number of samples }
  89.       begin
  90.        SampSeg := MemW [TableSeg:(TableOfs + n + 2)]; { get segment }
  91.       { update the list of segments - count ROM hits - increment index
  92.         into table. }
  93.         AddSeg (SampSeg);
  94.         if (SampSeg = $F000) then NBIOS := NBIOS + 1;
  95.         if (SampSeg = $C800) then NFD   := NFD  + 1;
  96.         n := n + 4;
  97.       end;
  98.     end;                      { End loop over the number of samples }
  99.     procedure PrintTotals;
  100.   { Output first screen of total tallies }
  101.     begin
  102.       ClrScr;      gotoxy (31,1);    writeln ('Execution Profiler');
  103.       writeln;
  104. writeln('Location of accumulated address table & length (all hex):');
  105. writeln('Seg      = ', Hex(TableSeg), '  Ofs      = ', 
  106.                            Hex(TableOfs),'  Length = ', Hex(NSampls));
  107. writeln;
  108. writeln ('Code segment for this program is: ', Hex(CSeg));   writeln;
  109. writeln ('There are ', NSeg, ' distinct CS registers:');     writeln;
  110.       for i := 1 to NSeg do
  111.         writeln ('# ', i:4, ' is ', Hex (SegArray[i,1]),
  112.                  '; there were ', SegArray[i,2]:6 , ' counts.');
  113.       writeln;
  114.       writeln ('There were ', NSampls:6, ' total counts, spanning ',
  115.                                   (NSampls/18.2):10:2, ' seconds.');
  116.       {NOTE: seconds printout assumes clock not speeded up }
  117.       writeln;
  118. writeln ('There were ', NFD:6,  ' counts in Fixed Disk Control ',
  119.                '(CS=C800).');
  120.       writeln;
  121.       writeln ('There were ', NBIOS:6, ' counts in BIOS (CS=F000).');
  122.       writeln;  writeln;  writeln('Press return to continue...');
  123.       readln;
  124.     end;
  125.     procedure SegHist;
  126.   { prints out a segment histogram }
  127.     var
  128.       maxcount:  integer;
  129.       ans:       char;
  130.       xn, xs:    real;
  131.       NDots:     integer;
  132.       nstrng:    MaxString;
  133.     begin
  134.       ClrScr;      gotoxy(30,1);      write ('Segment Histogram');
  135.       gotoxy(1,5);      
  136.       write('Do you want to print the histogram (y/n)? ');
  137.       readln (ans);      DoPrint := false;
  138.       if ((ans = 'y') or (ans = 'Y')) then DoPrint := true;
  139.       ClrScr;      gotoxy(30,1);      println ('Segment Histogram');
  140.       xn := NSampls;
  141.       println (nul);
  142.       print ( '        0');
  143.       print ( '                                 .5');
  144.       print ( '                                 1.0');
  145.       print ( '        |');
  146.       print ( '                                  |');
  147.       print ( '                                  |');
  148.       println (nul);      println (nul);
  149.       for i := 1 to NSeg do
  150.       begin
  151.         xs := SegArray [i,2];
  152.         bins [i] := xs / xn;
  153.         print (Hex (SegArray[i,1]) + ' >   ');
  154.         NDots := round (70.*bins [i]);
  155.         for j := 1 to NDots do print ('*');
  156.         println (nul);
  157.       end;
  158.       println (nul);
  159.       Str (NSeg:4, nstrng);
  160.       println ('There were ' + nstrng + ' different segments.');
  161.       Str (NSampls:4, nstrng);
  162.       println ('There were ' + nstrng + ' total counts');
  163.       writeln;  writeln ('Press return to continue...');   readln;
  164.     end;
  165.     procedure OfsHist;          { prints out an offset histogram }
  166.     label  EndOfsHist;
  167.     var
  168.       maxcount, NDots, iseg, iwidth, nbins, ncounts:  integer;
  169.       index, offset, segment, minofs, maxofs, ofslabel: integer;
  170.       ans:       char;
  171.       xn, xs:    real;
  172.       nstrng:    MaxString;
  173.       ListAll:   boolean;
  174.     begin
  175.       repeat
  176.       minofs := $ffff;      maxofs := 0;
  177.       ClrScr;
  178.       gotoxy(30,1);      write ('Offset Histogram');
  179.       gotoxy(1,5);
  180. write('Enter the number of the segment you want (0 to end): ');
  181.       readln (iseg);
  182.       if (iseg = 0) then goto EndOfsHist;
  183.       nbins := 10;
  184.       gotoxy(1,6);
  185.       write('Enter the number of bins desired (< = 2048): ');
  186.       readln (nbins);
  187.       write('Do you want to print the histogram (y/n)? ');
  188.       readln (ans);
  189.       DoPrint := false;
  190.       if ((ans = 'y') or (ans = 'Y')) then DoPrint := true;
  191.       write('Do you want to display empty bins (y/n)? ');
  192.       readln (ans);
  193.       ListAll := false;
  194.       if ((ans = 'y') or (ans = 'Y')) then ListAll := true;
  195.       ClrScr;      gotoxy(24,1);
  196.       println ('Offset Histogram for Segment ' 
  197.                                        + Hex (SegArray[iseg,1]));
  198.       println (nul);      print ( '             ');
  199.       print ( '0                              .5');
  200.       print ( '                              1.0');
  201.       println (nul);      print ( '             ');
  202.       print ( '|                               |');
  203.       print ( '                                |');
  204.       println (nul);      println (nul);
  205.       for i := 0 to nbins        { zero out count array and scalars }
  206.                  do bins [i] := 0;    
  207.       ncounts := 0;
  208.       n := 0;                    { find max and min offsets (/2) }
  209.       for i := 1 to NSampls do
  210.       begin
  211.         SampSeg := MemW [TableSeg:(TableOfs + n + 2)];
  212.         SampOfs := MemW [TableSeg:(TableOfs + n    )];
  213.         n := n + 4;
  214.         if (SampSeg = SegArray[iseg,1]) then
  215.         begin
  216.           if ( Hex (SampOfs) > Hex (maxofs) ) then maxofs := SampOfs;
  217.           if ( Hex (Sampofs) < Hex (minofs) ) then minofs := SampOfs;
  218.         end;
  219.       end;
  220.       iwidth := (maxofs - minofs) div nbins;    { words per bin }
  221.       if (iwidth = 0) then iwidth := 1;
  222.       n := 0;                   { accumulate counts in the bins }
  223.       for i := 1 to NSampls do
  224.       begin
  225.         SampSeg := MemW [TableSeg:(TableOfs + n + 2)];
  226.         SampOfs := MemW [TableSeg:(TableOfs + n    )];
  227.         n := n + 4;
  228.         if (SampSeg = SegArray[iseg,1]) then
  229.         begin
  230.           ncounts := ncounts + 1;
  231.           index := (SampOfs - minofs) div iwidth;
  232.           bins [index] := bins [index] + 1.;
  233.         end;
  234.       end;
  235.       ofslabel := minofs;           { print the histogram }
  236.       if (ncounts > 0) then
  237.       begin
  238.         for i := 0 to nbins do
  239.         begin
  240.           if ( (bins[i] > 0) or (ListAll) ) then
  241.           begin
  242.             print (Hex (ofslabel) + '+' +
  243.                    Hex (iwidth) + ' >   ');
  244.             NDots := round (65.*(bins [i] / ncounts));
  245.             if ( (NDots = 0) and (bins [i] <> 0) ) then NDots := 1;
  246.             for j := 1 to NDots do print ('*');
  247.             println (nul);
  248.           end;
  249.           ofslabel := ofslabel + iwidth;
  250.         end;
  251.       end;
  252.       println (nul);
  253.       Str (ncounts:4, nstrng);          { print final statistics }
  254.       println ('There were ' + nstrng + ' counts in this segment, ' +
  255.                 Hex (SegArray[iseg,1]));
  256.       println ('Minimum offset in this segment was ' + Hex (minofs));
  257.       println ('Maximum offset in this segment was ' + Hex (maxofs));
  258.       writeln;      writeln ('Press return to continue...');
  259.       readln;
  260.       until (false);
  261. EndOfsHist:
  262.     end;
  263.  
  264. { MAIN: }
  265.     begin;
  266.       Loop;             { Initial loop over samples }
  267.       PrintTotals;      { Print total hits, segments, etc. }
  268.       SegHist;          { Print Segment Histogram }
  269.       OfsHist;          { Print Offset Histograms for selected segments }
  270.     end.
  271.